app hyperpoc
enda
rem ---------------------------------
proc impdata%:(par$)
rem ---------------------------------
rem
rem  impdata% reads records from the PSION database.
rem	When called at card open time fields from the record found
rem	are displayed in the card area.
rem  	When called at object activation time it reads the same record
rem   	and offers the phone numbers contained in the record for dialling.
rem  par$ is a chr$(13) separated list with the following items:
rem	1. Search string (can contain wild cards)
rem  	2. Data File name (can be short name)
rem	3. Occurence (the n-th matching record is displayed)
rem	4. List of up to 16 fields to be displayed (e.g. 1,3-5,7)
rem	   (Phone numbers are extracted on activation from the 
rem         first 32 fields of the record regardless of this list).
rem

rem variables
local r%,p%,i%,k%,j%,u%,px%,py%,pw%,ph%,y%,fil$(128),srch$(50),fl$(50),occur&,h%,buf$(255),p&,l%,s%,k&,pk%
local flds%(16),s$(255),t$(255),off%(6),inf%(32),lhnd%,phone$(6,24),lab$(6,10),pn%,tw%,mxw%

onerr err1

rem analyze parameter string
	r% = loc(par$,chr$(13))
	srch$ = mid$(par$,1,r%-1)
	p% = r%
	r% = loc(right$(par$,len(par$)-p%),chr$(13))
	fil$ = mid$(par$,p%+1,r%-1)
	p% = p%+r%
	r% = loc(right$(par$,len(par$)-p%),chr$(13))
	occur& = val(mid$(par$,p%+1,r%-1))
	fl$ = right$(par$,len(par$)-p%-r%)
	fil$ = parse$(fil$,"LOC::M:\DAT\*.DBF",off%())
	if onAct%	rem activated
rem get label information from DBF file
		p& = 56				rem position first record
		r% = ioopen(h%,fil$,$200)
		if r% < 0 : raise r% : endif
		r% = ioread(h%,addr(buf$)+1,15) rem read File Header
		if r% < 0 : raise r% : endif
		pokeb addr(buf$),r%		rem set string length
		if buf$ <> "OPLDatabaseFile" : raise -109 : endif
		while 1
			r% = ioseek(h%,1,p&)		rem to next record
			if r% < 0 : break : endif
			r% = ioread(h%,addr(buf$)+1,2)  rem length byte and tag
			if r% < 0 : break : endif
			pokeb addr(buf$),r%
			l% = asc(buf$)			rem length - 2
			p& = p& + l% + 2		rem next record
			if right$(buf$,1) = "0"
				k& = 8			rem start of labels
				ioseek(h%,3,k&)
				r% = ioread(h%,addr(buf$)+1,2) rem length byte and tag
				if r% < 0 : break : endif
				pokeb addr(buf$),r%
				l% = asc(buf$)
				while l% > 0
					r% = ioread(h%,addr(buf$)+1,1)	rem label length byte
					if r% < 0 : break : endif
					pokeb addr(buf$),r%
					s% = asc(buf$)
					pn% = pn%+1			rem field number
					if s%
						r% = ioread(h%,addr(buf$)+1,s%) rem read label
						if r% < 0 : break : endif
						pokeb addr(buf$),r%
						if asc(buf$) = 5	rem label contains phone symbol
							i% = i%+1
							lab$(i%) = left$(right$(buf$,len(buf$)-1),10)
							flds%(i%) = pn%
							if i% = 6 : break : endif
						endif
					endif
					l% = l% - s% - 1
				endwh
				break
			endif
		endwh
		ioclose(h%)
	else	
rem get default print area
		px% = gx
		py% = gy
		pw% = ObjW%+ObjX%-px%
		ph% = ObjH%+ObjY%-py%
rem process rest of parameter string
		i% = 0
		while j% < 16 and i% < 16
			i% = i%+1
			t$ = extract$:(fl$,i%)
			if len(t$)
				r% = loc(t$,"-") rem range specification
				if r%
					u% = val(left$(t$,r%-1))
					r% = val(right$(t$,len(t$)-r%))
					while u% <= r% and j% < 16
						j% = j%+1
						flds%(j%) = u%
						u% = u%+1
					endwh
				else
					j% = j%+1
					flds%(j%) = val(t$)
				endif
			endif
		endwh
rem set field default numbers
		if j% = 0
			flds%(1) = 1 : flds%(2) = 2 : flds%(3) = 3 : flds%(4) = 4
		endif
	endif
rem open file
	open fil$,b,f1$,f2$,f3$,f4$,f5$,f6$,f7$,f8$,f9$,f10$,f11$,f12$,f13$,f14$,f15$,f16$,f17$,f18$,f19$,f20$,f21$,f22$,f23$,f24$,f25$,f26$,f27$,f28$,f29$,f30$,f31$,f32$
rem find record
	while 1
		if find("*"+srch$+"*") = 0
			close
			return
		endif
		if occur& = 1 : break : endif
		occur& = occur& - 1
		next
	endwh
rem initialize display
	if onAct%
		lock on
		dinit "Dial"
	else
		gfont 1 : gstyle 0 : gtmode 3
		y% = py%+1
		ginfo inf%()
	endif
rem process fields
	while k% < 16 and ( y% < py%+ph%-1 or onAct% )
		k% = k%+1
		j% = flds%(k%)
		if j% > 0 and j% <= 32
			vector j%
			j1,j2,j3,j4,j5,j6,j7,j8,j9,j10,j11,j12,j13,j14,j15,j16,j17,j18,j19,j20,j21,j22,j23,j24,j25,j26,j27,j28,j29,j30,j31,j32
			endv
j1::
			s$ = b.f1$
j0::
			while len(s$)
				r% = loc(s$,chr$(21))  rem find line breaks
				if r%
					t$ = left$(s$,r%-1)
					s$ = right$(s$,len(s$)-r%)
				else
					t$ = s$ : s$ = ""
				endif
				if onAct%
					if pk% = 4 : break : endif
					pk% = pk% + 1
					phone$(pk%) = strip$:(t$)	rem collect phone numbers
					dedit phone$(pk%),lab$(k%)	rem build dialog box
				else
					if y% >= py%+ph%-1 : break : endif
					tw% = min(pw%-4,gtwidth(t$))
					if tw% > mxw%
						gat px%+mxw%+2,py%
						gfill tw%-mxw%,y%-py%,1	rem extend print area
						mxw% = tw%
					else
						tw% = mxw%
					endif
					y% = y% + inf%(3)  		rem character height
					gat px%+2,y%
					gprintclip(t$,tw%)		rem print line
				endif
			endwh
			continue
j2::			s$ = b.f2$ : goto j0
j3::			s$ = b.f3$ : goto j0
j4::			s$ = b.f4$ : goto j0
j5::			s$ = b.f5$ : goto j0
j6::			s$ = b.f6$ : goto j0
j7::			s$ = b.f7$ : goto j0
j8::			s$ = b.f8$ : goto j0
j9::			s$ = b.f9$ : goto j0
j10::			s$ = b.f10$ : goto j0
j11::			s$ = b.f11$ : goto j0
j12::			s$ = b.f12$ : goto j0
j13::			s$ = b.f13$ : goto j0
j14::			s$ = b.f14$ : goto j0
j15::			s$ = b.f15$ : goto j0
j16::			s$ = b.f16$ : goto j0
j17::			s$ = b.f17$ : goto j0
j18::			s$ = b.f18$ : goto j0
j19::			s$ = b.f19$ : goto j0
j20::			s$ = b.f20$ : goto j0
j21::			s$ = b.f21$ : goto j0
j22::			s$ = b.f22$ : goto j0
j23::			s$ = b.f23$ : goto j0
j24::			s$ = b.f24$ : goto j0
j25::			s$ = b.f25$ : goto j0
j26::			s$ = b.f26$ : goto j0
j27::			s$ = b.f27$ : goto j0
j28::			s$ = b.f28$ : goto j0
j29::			s$ = b.f29$ : goto j0
j30::			s$ = b.f30$ : goto j0
j31::			s$ = b.f31$ : goto j0
j32::			s$ = b.f32$ : goto j0
		endif
	endwh
	close
	if onAct%
		i% = 1
		if pk% > 1
			i% = dialog - 1		rem Unfortunately we have to use 2 steps
			if i% <= 0 : return : endif
			dinit "Dial"
			dedit phone$(i%),"Number"
		endif
		dbuttons "Cancel",-27,"Dial",9,"Dial out",13
		r% = dialog
		if r%
			dial:(phone$(i%),(r%=13))
		endif
	else
		gat px%,py%
		gborder 0,mxw%+3,y%-py%+1
	endif
	return
err1::
	r% = err
	ioclose(h%)
	trap use b		rem make sure we are talking to dbf file
	if err = 0
		trap close	rem close dbf file
	endif
	return r%
endp

rem edParm$: supports the editing process for impdata objects.

proc edParm$:(parm$)
local r%,p%,off%(6),srch$(50),fil$(128),fl$(50),occur&
	if len(parm$)
		r% = loc(parm$,chr$(13))
		srch$ = mid$(parm$,1,r%-1)
		p% = r%
		r% = loc(right$(parm$,len(parm$)-p%),chr$(13))
		fil$ = mid$(parm$,p%+1,r%-1)
		p% = p%+r%
		r% = loc(right$(parm$,len(parm$)-p%),chr$(13))
		occur& = val(mid$(parm$,p%+1,r%-1))
		fl$ = right$(parm$,len(parm$)-p%-r%)
	else
		occur& = 1
		fil$ = "M:\DAT\DATA"
		fl$ = "1-4"
	endif
	fil$ = parse$(fil$,"LOC::M:\DAT\*.DBF",off%())
	dinit "Import database record"
	dfile fil$,"Data",16
	dedit srch$,"Search string"
	dlong occur&,"Occurence",1,32
	dedit fl$,"Fields displayed"
	dialog
	fil$ = parse$(fil$,"",off%())
	return srch$+chr$(13)+mid$(fil$,off%(2),off%(5)-off%(2))+chr$(13)+num$(occur&,2)+chr$(13)+fl$
endp